home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / html / ps2gif.pl < prev    next >
Encoding:
Text File  |  1998-03-24  |  2.6 KB  |  111 lines
  1. /*  $Id: ps2gif.pl,v 1.2 1998/03/24 13:38:09 jan Exp $
  2.  
  3.     Designed and implemented by Jan Wielemaker
  4.     E-mail: jan@swi.psy.uva.nl
  5.  
  6.     Copyright (C) 1996 University of Amsterdam. All rights reserved.
  7. */
  8.  
  9. :- module(ps2gif,
  10.       [ ps2gif/2,            % +In, +Out
  11.         ps2gif/3            % +In, +Out, +Options
  12.       ]).
  13.  
  14. option(gs,    gs).
  15. option(res,    72).
  16. option(device,    ppmraw).
  17. option(tmp,    Tmp) :-
  18.     tmp_file(ps2gif, Tmp).
  19.  
  20. ps2gif(In, Out) :-
  21.     ps2gif(In, Out, []).
  22.  
  23. ps2gif(In, Out, Options) :-
  24.     get_option(Options, tmp(Tmp)),
  25.     get_option(Options, res(Res0)),
  26.     absolute_file_name(In, [ access(read),
  27.                  extensions([ps, eps])
  28.                    ],
  29.                InFile),
  30.     get_ps_parameters(InFile, EPS, bb(X1,Y1,X2,Y2)),
  31.     (   get_option(Options, width(W))
  32.     ->  ScaleX is W/((X2-X1)/72)
  33.     ;   ScaleX is 1
  34.     ),
  35.     (   get_option(Options, height(H))
  36.     ->  ScaleY is H/((Y2-Y1)/72)
  37.     ;   ScaleY is 1
  38.     ),
  39.     ResX is Res0 * ScaleX,
  40.     ResY is Res0 * ScaleY,
  41.     (   ResX =:= ResY
  42.     ->  Res = ResX
  43.     ;   sformat(Res, '~wx~w', [ResX, ResY])
  44.     ),
  45.     BBX is -X1,
  46.     BBY is -Y1,
  47.     BBW0 = X2 - X1,
  48.     BBH0 = Y2 - Y1,
  49.     BBW is round(BBW0 * ResX / 72),
  50.     BBH is round(BBH0 * ResY / 72),
  51.     gs_command([size(BBW,BBH),tmp(Tmp),res(Res)|Options], Cmd),
  52.     telling(Old), tell(pipe(Cmd)),
  53.     format('~w ~w translate ', [BBX, BBY]),
  54.     format('(~w) run ', InFile),
  55.     (   EPS == eps
  56.     ->  format('showpage ')
  57.     ;   true
  58.     ),
  59.     format('quit~n'),
  60.     told, tell(Old),
  61.     (   exists_file(Tmp)
  62.     ->  ppm2gif(Tmp, Out, Options),
  63.         delete_file(Tmp)
  64.     ;   EPS == ps,
  65.         format(user_error,
  66.            'No output from ~w, Trying again with showpage~n',
  67.            [InFile]),
  68.         telling(Old), tell(pipe(Cmd)),
  69.         format('~w ~w translate ', [BBX, BBY]),
  70.         format('(~w) run ', InFile),
  71.         format('showpage '),
  72.         format('quit~n'),
  73.         told, tell(Old),
  74.         ppm2gif(Tmp, Out, Options)
  75.     ).
  76.  
  77. ppm2gif(Tmp, Out, Options) :-
  78.     (   get_option(Options, margin(B))
  79.     ->  aformat(Cmd,
  80.             'pnmcrop < ~w | pnmmargin ~w | pnmmargin -black 1 | ppmtogif > ~w',
  81.             [Tmp, B, Out])
  82.     ;   aformat(Cmd, '~w < ~w | ~w > ~w',
  83.             [pnmcrop, Tmp, ppmtogif, Out])
  84.     ),
  85.     shell(Cmd).
  86.  
  87. gs_command(Options, Cmd) :-
  88.     get_option(Options, gs(GS)),
  89.     get_option(Options, res(Res)),
  90.     get_option(Options, device(Dev)),
  91.     get_option(Options, tmp(Tmp)),
  92.     (   get_option(Options, size(W, H))
  93.     ->  sformat(SCmd, '-g~wx~w', [W, H])
  94.     ;   SCmd = ''
  95.     ),
  96.     aformat(Cmd,
  97.         '~w -q -dNOPAUSE -sDEVICE=~w ~w -r~w -sOutputFile=~w',
  98.         [GS, Dev, SCmd, Res, Tmp]).
  99.     
  100.     
  101. get_option(List, Term) :-
  102.     memberchk(Term, List), !.
  103. get_option(_, Term) :-
  104.     functor(Term, Name, _),
  105.     option(Name, Def), !,
  106.     arg(1, Term, Def).
  107.     
  108. aformat(Atom, Fmt, Args) :-
  109.     sformat(Str, Fmt, Args),
  110.     string_to_atom(Str, Atom).
  111.